home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2005 October / PCWOCT05.iso / Software / FromTheMag / The GIMP 2.2.8 / gimp-2.2.8-i586-setup.exe / {app} / share / gimp / 2.0 / scripts / font-map.scm < prev    next >
Encoding:
Text File  |  2005-06-30  |  3.8 KB  |  147 lines
  1. ;; font-select
  2. ;; Spencer Kimball
  3.  
  4. (define (max-font-width text use-name font-list font-size)
  5.   (let* ((list     font-list)
  6.      (width    0)
  7.      (maxwidth 0)
  8.      (font     "")
  9.      (extents  '()))
  10.     (while list
  11.        (set! font (car list))
  12.        (set! list (cdr list))
  13.        (if (= use-name TRUE)
  14.            (set! text font))
  15.        (set! extents (gimp-text-get-extents-fontname text
  16.                              font-size PIXELS
  17.                              font))
  18.        (set! width (nth 0 extents))
  19.        (if (> width maxwidth)
  20.            (set! maxwidth width)))
  21.     maxwidth))
  22.  
  23.  
  24. (define (max-font-height text use-name font-list font-size)
  25.   (let* ((list      font-list)
  26.      (height    0)
  27.      (maxheight 0)
  28.      (font      "")
  29.      (extents   '()))
  30.     (while list
  31.        (set! font (car list))
  32.        (set! list (cdr list))
  33.        (if (= use-name TRUE)
  34.            (set! text font))
  35.        (set! extents (gimp-text-get-extents-fontname text
  36.                              font-size PIXELS
  37.                              font))
  38.        (set! height (nth 1 extents))
  39.        (if (> height maxheight)
  40.            (set! maxheight height)))
  41.     maxheight))
  42.  
  43.  
  44. (define (script-fu-font-map text
  45.                 use-name
  46.                 labels
  47.                 font-filter
  48.                 font-size
  49.                 border
  50.                 colors)
  51.   (let* ((font        "")
  52.      (count       0)
  53.          (font-list  (cadr (gimp-fonts-get-list font-filter)))
  54.      (num-fonts  (length font-list))
  55.      (label-size (/ font-size 2))
  56.      (border     (+ border (* labels (/ label-size 2))))
  57.      (y           border)
  58.      (maxheight  (max-font-height text use-name font-list font-size))
  59.      (maxwidth   (max-font-width  text use-name font-list font-size))
  60.      (width      (+ maxwidth (* 2 border)))
  61.      (height     (+ (+ (* maxheight num-fonts) (* 2 border))
  62.             (* labels (* label-size num-fonts))))
  63.      (img        (car (gimp-image-new width height (if (= colors 0)
  64.                                GRAY RGB))))
  65.      (drawable   (car (gimp-layer-new img width height (if (= colors 0)
  66.                                    GRAY-IMAGE RGB-IMAGE)
  67.                       "Background" 100 NORMAL-MODE)))) 
  68.  
  69.     (gimp-context-push)
  70.  
  71.     (gimp-image-undo-disable img)
  72.  
  73.     (if (= colors 0)
  74.     (begin
  75.       (gimp-context-set-background '(255 255 255))
  76.       (gimp-context-set-foreground '(0 0 0))))
  77.  
  78.     (gimp-image-add-layer img drawable 0)
  79.     (gimp-edit-clear drawable)
  80.  
  81.     (if (= labels TRUE)
  82.     (begin
  83.       (set! drawable (car (gimp-layer-new img width height
  84.                           (if (= colors 0)
  85.                           GRAYA-IMAGE RGBA-IMAGE)
  86.                           "Labels" 100 NORMAL-MODE)))
  87.       (gimp-image-add-layer img drawable -1)))
  88.       (gimp-edit-clear drawable)
  89.  
  90.     (while font-list
  91.        (set! font (car font-list))
  92.        (set! font-list (cdr font-list))
  93.  
  94.        (if (= use-name TRUE)
  95.            (set! text font))
  96.  
  97.        (gimp-text-fontname img -1
  98.                    border
  99.                    y
  100.                    text
  101.                    0 TRUE font-size PIXELS
  102.                    font)
  103.  
  104.        (set! y (+ y maxheight))
  105.  
  106.        (if (= labels TRUE)
  107.            (begin
  108.          (gimp-floating-sel-anchor (car (gimp-text-fontname img drawable
  109.                                     (- border
  110.                                        (/ label-size 2))
  111.                                     (- y
  112.                                        (/ label-size 2))
  113.                                     font
  114.                                     0 TRUE
  115.                                     label-size PIXELS
  116.                                     "Sans")))
  117.         (set! y (+ y label-size))))
  118.  
  119.  
  120.        (set! count (+ count 1)))
  121.  
  122.     (gimp-image-set-active-layer img drawable)
  123.  
  124.     (gimp-image-undo-enable img)
  125.     (gimp-display-new img)
  126.  
  127.     (gimp-context-pop)))
  128.  
  129. (script-fu-register "script-fu-font-map"
  130.             _"_Font Map..."
  131.             "Generate a listing of fonts matching a filter"
  132.             "Spencer Kimball"
  133.             "Spencer Kimball"
  134.             "1997"
  135.             ""
  136.             SF-STRING     _"_Text" "How quickly daft jumping zebras vex."
  137.             SF-TOGGLE     _"Use font _name as text" FALSE
  138.             SF-TOGGLE     _"_Labels"                TRUE
  139.             SF-STRING     _"_Filter (regexp)"       "Sans"
  140.             SF-ADJUSTMENT _"Font _size (pixels)"    '(32 2 1000 1 10 0 1)
  141.             SF-ADJUSTMENT _"_Border (pixels)"       '(10 0  200 1 10 0 1)
  142.             SF-OPTION     _"_Color scheme"          '(_"Black on white"
  143.                                   _"Active colors"))
  144.  
  145. (script-fu-menu-register "script-fu-font-map"
  146.              _"<Toolbox>/Xtns/Script-Fu/Utils")
  147.